#ifndef __K2L_H__
#define __K2L_H__

#define K2L_ABORT(...) do { printf(__VA_ARGS__); abort(); } while(0)
#define K2L_ABORT_S(s, ...) do { printf(__VA_ARGS__); k2l_disp_line(s, K2L_STDOUT); abort(); } while(0)
#define K2L_RETURN_ABORT(msg) do { static const k2l_string_t s = DECLARE_STRING(msg); \
		static const  k2l_syspriv_t e = DECLARE_SYSPRIV(K2L_SYS_TYPE_ABORTED, K2L_CAST(&s)); \
		return K2L_CAST(&e); } while(0)

typedef char           k2l_char;
typedef int            k2l_int;
typedef unsigned char  k2l_u8;
typedef unsigned int   k2l_u32;

typedef enum {
	SREF_TYPE_SOBJ=0, SREF_TYPE_INT, SREF_TYPE_CHR, SREF_TYPE_UNDEF,
} k2l_sexp_ref_type_e;

typedef struct {
	k2l_u32 refcnt;
	const struct _k2l_type_t *type;
} k2l_sobj_t;

typedef union _k2l_sexp_ref {
	k2l_sobj_t *ptr;
	struct _k2l_imm_t {
		k2l_sexp_ref_type_e type: 2;
		k2l_int imm: 30;
	} t;
	k2l_u32 w;
} k2l_sexp_ref;

typedef const struct _k2l_type_t {
	const struct _k2l_type_t *parent;
	k2l_sexp_ref sig;
	void (*release)(k2l_sexp_ref);
	void (*print)(k2l_sexp_ref);
} k2l_type_t;
k2l_type_t k2l_type_imms[];

#define SOBJ_REF(u) (((k2l_sobj_t*)(u).ptr)->refcnt)
#define SOBJ_TYPE(u) (((k2l_sobj_t*)(u).ptr)->type)
#define imm_int(u) ((k2l_int)((u).t.imm))
#define imm_char(u) ((k2l_char)((u).t.imm))
#define K2L_CAST(p) ((k2l_sexp_ref)(k2l_sobj_t*)(p))
#define K2L_TYPE(u) (is_imm(u)? &k2l_type_imms[(u).t.type]: SOBJ_TYPE(u))

typedef const struct {
	k2l_type_t suqer;
	k2l_int (*length)(k2l_sexp_ref);
	k2l_sexp_ref (*elt)(k2l_sexp_ref, k2l_int);
	void (*set)(k2l_sexp_ref, k2l_int, k2l_sexp_ref);
} k2l_type_sequence_t;
k2l_type_t k2l_type_sequence_base;
#define SEQ_LENGTH(u)  (((k2l_type_sequence_t*)SOBJ_TYPE(u))->length(u))
#define SEQ_ELT(u,i)   (((k2l_type_sequence_t*)SOBJ_TYPE(u))->elt(u, i))
#define SEQ_SET(u,i,v) (((k2l_type_sequence_t*)SOBJ_TYPE(u))->set(u, i, v))

typedef struct {
	k2l_sobj_t sexp;
	k2l_sexp_ref car;
	k2l_sexp_ref cdr;
} k2l_cons_t;
k2l_type_sequence_t k2l_type_cons;
#define CONS_CAR(u) (((k2l_cons_t*)(u).ptr)->car)
#define CONS_CDR(u) (((k2l_cons_t*)(u).ptr)->cdr)
#define CONS_FIRST(u) (CONS_CAR(u))
#define CONS_SECOND(u) (CONS_CAR(CONS_CDR(u)))
#define CONS_THIRD(u) (CONS_CAR(CONS_CDR(CONS_CDR(u))))
#define CONS_FORTH(u) (CONS_CAR(CONS_CDR(CONS_CDR(CONS_CDR(u)))))
#define CONS_FIFTH(u) (CONS_CAR(CONS_CDR(CONS_CDR(CONS_CDR(CONS_CDR(u))))))

typedef struct {
	k2l_sobj_t sexp;
	k2l_int len;
	k2l_char *head;
} k2l_string_t;
k2l_type_sequence_t k2l_type_string;
#define STRING_HEAD(u) (((k2l_string_t*)(u).ptr)->head)
#define STRING_LEN(u) (((k2l_string_t*)(u).ptr)->len)
#define DECLARE_STRING(str) {{0, &k2l_type_string.suqer}, sizeof(str), (str)}

typedef struct {
	k2l_sobj_t sexp;
	k2l_u32 flags;
	k2l_sexp_ref name; // k2l_string_t
	k2l_sexp_ref val;
	k2l_sexp_ref fnc; // function_t
} k2l_symbol_t;
k2l_type_t k2l_type_symbol;
#define SYMBOL_FLG_KEYWORD 1
#define SYMBOL_FLG_CONSTANT 2
#define SYMBOL_FLAGS(p) (((k2l_symbol_t*)(p).ptr)->flags)
#define SYMBOL_NAME(p) (((k2l_symbol_t*)(p).ptr)->name)
#define SYMBOL_VALUE(p) (((k2l_symbol_t*)(p).ptr)->val)
#define SYMBOL_FUNCTION(p) (((k2l_symbol_t*)(p).ptr)->fnc)
#define DECLARE_SYMBOL(name,v,f) {{0, &k2l_type_symbol}, 0, K2L_CAST(&(k2l_string_t)DECLARE_STRING(name)), v, f}

typedef const struct {
	k2l_type_t suqer;
	k2l_sexp_ref (*invoke)(k2l_sexp_ref self, k2l_sexp_ref args, k2l_sexp_ref *mvp);
} k2l_type_callee_t;
k2l_type_t k2l_type_callee_base;
#define APPLY(self, args, mvp) (((k2l_type_callee_t*)SOBJ_TYPE(self))->invoke(self, args, mvp))

typedef struct {
	k2l_sobj_t sexp;
	k2l_sexp_ref (*fnp)(k2l_sexp_ref, k2l_sexp_ref *mvp);
	k2l_char *argsig;
} k2l_function_t;
k2l_type_callee_t k2l_type_function;
#define FUNCTION(u) (((k2l_function_t*)(u).ptr)->fnp)
#define FUNCTION_SIG(u) (((k2l_function_t*)(u).ptr)->argsig)
#define DECLARE_FUNCTION(fnp, sig) {{0, &k2l_type_function.suqer}, (fnp), sig}
#define DECLARE_SYMBOL_FUNCTION(name, fn, sig) DECLARE_SYMBOL(name, K2L_NIL, K2L_CAST(&(k2l_function_t)DECLARE_FUNCTION(fn, sig)))

typedef struct {
	k2l_sobj_t sexp;
	k2l_sexp_ref (*fnp)(k2l_sexp_ref dyn, k2l_sexp_ref args, k2l_sexp_ref *mvp);
	k2l_char *argsig;
} k2l_specialop_t;
k2l_type_t k2l_type_specialop;
#define SPECIALOP(u) (((k2l_specialop_t*)(u).ptr)->fnp)
#define SPECIALOP_SIG(u) (((k2l_specialop_t*)(u).ptr)->argsig)
#define DECLARE_SPECIALOP(fn, sig) {{0, &k2l_type_specialop}, (fn), sig}
#define DECLARE_SYMBOL_SPECIALOP(name, fn, sig) DECLARE_SYMBOL(name, K2L_NIL, K2L_CAST(&(k2l_specialop_t)DECLARE_SPECIALOP(fn, sig)))
#define INVOKE_SPECIALOP(fn, dyn, args, mvp) ((SPECIALOP(fn))(dyn, args, mvp))

typedef struct {
	k2l_sobj_t sexp;
	k2l_sexp_ref lex; // env_t
	k2l_sexp_ref name; // k2l_string_t 
	k2l_sexp_ref def; // (ARG_DEF . BODY_DEF)
} k2l_lambdafn_t;
k2l_type_callee_t k2l_type_lambdafn;
k2l_type_callee_t k2l_type_macro;
#define LAMBDA_LEX(u) (((k2l_lambdafn_t*)(u).ptr)->lex)
#define LAMBDA_NAME(u) (((k2l_lambdafn_t*)(u).ptr)->name)
#define LAMBDA_DEF(u) (((k2l_lambdafn_t*)(u).ptr)->def)
#define LAMBDA_ARG(u) (CONS_CAR(LAMBDA_DEF(u)))
#define LAMBDA_BODY(u) (CONS_CDR(LAMBDA_DEF(u)))
#define EXPAND_MACRO(fn, args) APPLY(fn, args, NULL)

typedef const struct {
	k2l_type_t suqer;
	k2l_char (*getchar)(k2l_sexp_ref);
	void (*reset)(k2l_sexp_ref);
	void (*putchar)(k2l_sexp_ref, k2l_char);
} k2l_type_stream_t;
k2l_type_t k2l_type_stream_base;
#define STREAM_GETCHAR(u) (((k2l_type_stream_t*)SOBJ_TYPE(u))->getchar(u))
#define STREAM_RESET(u)   (((k2l_type_stream_t*)SOBJ_TYPE(u))->reset(u))
#define STREAM_PUTCHAR(u, c) (((k2l_type_stream_t*)SOBJ_TYPE(u))->putchar(u, c))

typedef struct {
	k2l_sobj_t sexp;
	k2l_int fd;
	k2l_int mark;
	k2l_char buf;
} k2l_filedesc_t;
k2l_type_stream_t k2l_type_filedesc;
#define FIS_FD(u) (((k2l_filedesc_t*)(u).ptr)->fd)
#define FIS_MARK(u) (((k2l_filedesc_t*)(u).ptr)->mark)
#define FIS_BUF(u) (((k2l_filedesc_t*)(u).ptr)->buf)

typedef struct {
	k2l_sobj_t sexp;
	k2l_sexp_ref src; // k2l_string_t*
	k2l_int pos;
} k2l_string_stream_t;
k2l_type_stream_t k2l_type_string_stream;
#define STGSTM_SRC(u) (((k2l_string_stream_t*)(u).ptr)->src)
#define STGSTM_POS(u) (((k2l_string_stream_t*)(u).ptr)->pos)

typedef struct {
	k2l_sobj_t sexp;
	k2l_int len;
	struct _k2l_hashtab_ent {
		struct _k2l_hashtab_ent *next;
		k2l_string_t *key;
		k2l_sexp_ref value;
	} *tab[1];
} k2l_hashtab_t;
typedef k2l_u32 k2l_hash_t;
typedef struct _k2l_hashtab_ent k2l_hashtab_ent;
k2l_type_t k2l_type_hashtab;
#define HASHTAB_LEN(u) (((k2l_hashtab_t*)(u).ptr)->len)
#define HASHTAB_TAB(u) (((k2l_hashtab_t*)(u).ptr)->tab)
#define DECLARE_HASHTAB(test) {{0, &k2l_type_hashtab}, test, K2L_NIL}

typedef struct {
	k2l_sobj_t sexp;
	k2l_sexp_ref parent; // k2l_env_t
	k2l_sexp_ref symtab; // k2l_hashtab_t
} k2l_env_t;
k2l_type_t k2l_type_env;
#define ENV_PARENT(u) (((k2l_env_t*)(u).ptr)->parent)
#define ENV_SYMTAB(u) (((k2l_env_t*)(u).ptr)->symtab)

typedef enum {
	K2L_SYS_TYPE_LONGJMP=1, K2L_SYS_TYPE_ABORTED=3,
} k2l_sys_type_e;

typedef struct {
	k2l_sobj_t sexp;
	k2l_sys_type_e type;
	k2l_sexp_ref privp;
} k2l_syspriv_t;
k2l_type_t k2l_type_syspriv;
#define SYS_TYPE(u) (((k2l_syspriv_t*)(u).ptr)->type)
#define SYS_PRIVP(u) (((k2l_syspriv_t*)(u).ptr)->privp)
#define DECLARE_SYSPRIV(type, priv) {{0, &k2l_type_syspriv}, type, priv}
#define SYSPRIVF_DEF(n) K2L_CAST(&(k2l_syspriv_t)DECLARE_SYSPRIV(n, K2L_UNDEF))

#define is_imm(p) ((p).t.type != 0 || (p).w == 0)
#define is_imm_char(p) ((p).t.type == SREF_TYPE_CHR)
#define is_imm_int(p) ((p).t.type == SREF_TYPE_INT)
#define is_undef(p) ((p).t.type == SREF_TYPE_UNDEF)
#define is_nil(p) ((p).w == 0)
#define is_t(p) (g_k2l_t.w == (p).w)
#define _is_ref_type(ty, p) (!is_imm(p) && SOBJ_TYPE(p) == (k2l_type_t*)&(ty))
#define is_cons(p) _is_ref_type(k2l_type_cons, p)
#define is_symbol(p) _is_ref_type(k2l_type_symbol, p)
#define is_nil_or_t_or_symbol(p) (is_nil(p) || is_t(p) || is_symbol(p))
#define is_keyword(p) (is_symbol(p) && (SYMBOL_FLAGS(p) == SYMBOL_FLG_KEYWORD))
#define is_function(p) _is_ref_type(k2l_type_function, p)
#define is_callee(p) (is_function(p) || is_lambdafn(p))
#define is_string(p) _is_ref_type(k2l_type_string, p)
#define is_specialop(p) _is_ref_type(k2l_type_specialop, p)
#define is_lambdafn(p) _is_ref_type(k2l_type_lambdafn, p)
#define is_macro(p) _is_ref_type(k2l_type_macro, p)
#define is_stream(p) _is_ref_type(k2l_type_stream, p)
#define is_hashtab(p) _is_ref_type(k2l_type_hashtab, p)
#define is_env(p)  _is_ref_type(k2l_type_env, p)
#define is_syspriv(p) _is_ref_type(k2l_type_syspriv, p)
#define is_aborted(p) (is_syspriv(p) && (SYS_TYPE(p) == K2L_SYS_TYPE_ABORTED))
#define is_longjmp(p) (is_syspriv(p) && (SYS_TYPE(p) & K2L_SYS_TYPE_LONGJMP))
#define is_list(p) (is_cons(p) || is_nil(p))

#ifdef _DBG_MEMCNT
# define sexp_ref_up(p) do { if (!is_imm(p) && SOBJ_REF(p) && SOBJ_REF(p)++) { \
			printf("[ref_up  ] ref=%d : ", SOBJ_REF(p)); k2l_disp_line(p, K2L_STDOUT); }} while(0)
# define del_sexp(p) do { if (!is_imm(p) && SOBJ_REF(p)) {	\
			printf("[del_sexp] ref=%d : ", SOBJ_REF(p)); k2l_disp_line(p, K2L_STDOUT); \
			if (--SOBJ_REF(p) == 0 && SOBJ_TYPE(p) && SOBJ_TYPE(p)->release) \
			{ SOBJ_TYPE(p)->release(p); }}} while(0)
#else
# define sexp_ref_up(p) (void)(!is_imm(p) && SOBJ_REF(p) && SOBJ_REF(p)++)
# define del_sexp(p) do { if (!is_imm(p) && SOBJ_REF(p) && --SOBJ_REF(p) == 0 && SOBJ_TYPE(p) && SOBJ_TYPE(p)->release) { \
			SOBJ_TYPE(p)->release(p); }} while(0);
#endif

#define i2ps(v) K2L_CAST( (((k2l_int )v)<<2) | SREF_TYPE_INT )
#define c2ps(v) K2L_CAST( (((k2l_char)v)<<2) | SREF_TYPE_CHR )
#define K2L_NIL   K2L_CAST(NULL)
#define K2L_UNDEF K2L_CAST(SREF_TYPE_UNDEF)
#define K2L_STDIN        K2L_CAST(&g_k2l_stdin)
#define K2L_STDOUT       K2L_CAST(&g_k2l_stdout)

extern const k2l_sexp_ref g_k2l_t;
extern k2l_filedesc_t g_k2l_stdin, g_k2l_stdout;

extern k2l_sexp_ref new_sexp(k2l_u32 sz, k2l_type_t *type);
extern k2l_sexp_ref new_cons(k2l_sexp_ref a, k2l_sexp_ref d);
extern k2l_sexp_ref new_string(k2l_char* p);
extern k2l_sexp_ref new_symbol(k2l_sexp_ref name, k2l_sexp_ref value, k2l_sexp_ref func);
extern k2l_sexp_ref new_list(k2l_u32 len, ...);
extern k2l_sexp_ref new_hashtab(k2l_int len);
extern k2l_sexp_ref new_env(k2l_sexp_ref parent);
extern k2l_sexp_ref new_lambdafn(k2l_sexp_ref env, k2l_sexp_ref name, k2l_sexp_ref def);
extern k2l_sexp_ref new_filedesc(k2l_int fd);
extern k2l_sexp_ref k2l_eval(k2l_sexp_ref env, k2l_sexp_ref p, k2l_sexp_ref *mv);
extern k2l_sexp_ref k2l_read(k2l_sexp_ref env, k2l_sexp_ref stream);
extern void         k2l_disp(k2l_sexp_ref sexp, k2l_sexp_ref stream);
extern void         k2l_disp_line(k2l_sexp_ref sexp, k2l_sexp_ref stream);
extern void         k2l_load(k2l_char *file);
extern k2l_int      k2l_repl(k2l_int argc, k2l_char **argv);
extern k2l_int      k2l_typep(k2l_sexp_ref obj, k2l_type_t *type);
#endif /*  __K2L_H__ */
